home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u304.dms / in.adf / palette / PALET.AMOS / PALET.amosSourceCode
Encoding:
AMOS Source Code  |  1992-02-10  |  14.0 KB  |  416 lines
  1. '================================================================
  2. '                 P A L E T T E   S E T T E R  
  3. '
  4. '             John Collett, Hamilton, New Zealand  
  5. '
  6. '                        February 1992 
  7. '
  8. '      Copy any pieces from this which you may find useful,    
  9. '      but please leave this program intact, as it stands. 
  10. '
  11. '================================================================
  12. Screen Open 1,640,260,16,Hires
  13. Curs Off : Flash Off : Palette $0,$79A,$FFF,$FB5
  14. '====== Demo : Introduction, organisation, explanations =========
  15. HEADER
  16. LUPE[3,640,Hires]
  17. EX4
  18. LUPE[4,320,Lowres]
  19. Edit 
  20. '==============  Procedures used by Demo   ======================  
  21. Procedure HEADER
  22.    SH[100,30,"PALETTE SETTER DEMONSTRATION     AMOS 1.2",3]
  23.    SH[50,50,"This demo will show a Palette Setter in each of seven",2]
  24.    SH[50,60,"different settings and in three different modes.",2]
  25.    SH[50,70,"Each time you are ready to go on to the next stage of",2]
  26.    SH[50,80,"the demo, click on the OK button in the Palette Setter.",2]
  27.    SH[60,100,"The seven settings will be :",2]
  28.    SH[80,120,"Hires : 4, 8, and 16 colours",3]
  29.    SH[80,130,"Lores : 4, 8, 16, and 32 colours",3]
  30.    SH[50,150,"The demo contains brief explanations.",2]
  31.    SH[50,160,"Those on the first screen are largely unnecessary,",2]
  32.    SH[50,170,"but the later ones will be more informative.",2]
  33.    SH[180,190,"Press any key to start",3]
  34.    Wait Key 
  35. End Proc
  36. Procedure LUPE[N,W,RES]
  37.    For S=1 To N
  38.       NC=2^(S+1)
  39.       Screen Open 1,W,260,NC,RES : Colour 1,$79A
  40.       Curs Off : Flash Off 
  41.       If W=640
  42.          On S Proc EX1,EX2,EX3
  43.       End If 
  44.       'Set the mode
  45.       F$="0"
  46.       If W=320
  47.          If S=3 : F$="1" : End If 
  48.          If S=4
  49.             If Exist(":Amospic.IFF")
  50.                F$=":Amospic.IFF"
  51.             Else 
  52.                Locate 7,15 : Print ":Amospic.IFF not found"
  53.             End If 
  54.          End If 
  55.       End If 
  56.       PALET[F$]
  57.       Screen Close 1
  58.    Next 
  59. End Proc
  60. Procedure EX1
  61.    Ink 2
  62.    Polyline 116,102 To 116,106 To 210,106 To 210,102 : Draw 162,106 To 162,114
  63.    SH[130,124,"Click on",2] : SH[130,132,"these to",2]
  64.    SH[130,140,"select a",2] : SH[130,148,"colour.",2]
  65.    Polyline 306,22 To 314,22 To 314,52 To 306,52 : Draw 314,37 To 322,37
  66.    SH[330,36,"Click or slide on these",2] : SH[330,44,"to adjust RGB settings.",2]
  67.    SH[44,52,"$RGB -->",2] : SH[4,26,"Current",2] : SH[4,36,"selection -->",2]
  68.    SH[250,150,"Click on 'OK' when ready.",3]
  69. End Proc
  70. Procedure EX2
  71.    SH[320,20,"Copy, Swap, and Range",3]
  72.    SH[330,30,"Click on the 'From' colour,",2]
  73.    SH[330,38,"then on 'Copy', 'Swap' or 'Range',",2]
  74.    SH[330,46,"and then on the 'To/With' colour.",2]
  75.    SH[320,58,"OK",3]
  76.    SH[330,68,"Closes the Palette Setter.",2]
  77.    SH[320,80,"Save",3]
  78.    SH[330,90,"Stores current RGB settings in",2]
  79.    SH[330,98,"'RAM:palset.ASC', for future use.",2]
  80.    SH[320,110,"Fix",3]
  81.    SH[330,120,"Makes current settings the",2]
  82.    SH[330,128,"base for future resets.",2]
  83.    SH[320,140,"Rset",3]
  84.    SH[330,150,"Resets all colours.  Resets to the",2]
  85.    SH[330,158,"'Fixed' set if Fix has been used.",2]
  86.    SH[60,168,"MOVING THE SETTER",3]
  87.    SH[80,178,"To move the Palette Setter, press the Left Mouse",2]
  88.    SH[80,186,"Button in the Sample Colour box (top left).",2]
  89.    SH[80,194,"Drag a flickering rectangle the size of the Palette",2]
  90.    SH[80,202,"Setter to its new position.  Click it into place.",2]
  91.    SH[80,210,"It will remain within screen boundaries.",2]
  92. End Proc
  93. Procedure EX3
  94.    SH[320,20,"To include the Palette Setter",2]
  95.    SH[320,30,"in another AMOS program,",2]
  96.    SH[320,40,"copy the procedures used in this",2]
  97.    SH[320,50,"demo, from 'Procedure PALET[mode$]'",2]
  98.    SH[320,60,"to 'Procedure NEWPOS' inclusive.",2]
  99.    SH[320,80,"Invoke them with the call",2]
  100.    SH[320,90,"'PALET[mode$]', activated by a",2]
  101.    SH[320,100,"gadget, key press, or whatever.",2]
  102.    SH[10,110,"MODES",3]
  103.    SH[30,120,"The string argument in PALET[mode$] has three settings.",2]
  104.    SH[40,130,'- PALET["0"] runs the Palette Setter on the current screen.',2]
  105.    SH[40,140,'- PALET["1"] opens a file selector.  A selected IFF file will appear on',2]
  106.    SH[56,148,"a screen of appropriate dimensions, with the Palette Setter on top.",2]
  107.    SH[40,158,'- PALET[pic$] automatically loads the IFF file "pic$"',2]
  108.    SH[56,166,"(if it exists) before the Palette Setter appears.",2]
  109.    SH[10,178,"COLOURS",3]
  110.    SH[30,188,'The ["0"] mode starts off with the colours as set in P$ in the',2]
  111.    SH[30,196,"PALET[mode$] procedure, and the Rset gadget resets everything",2]
  112.    SH[30,204,"to those colours unless Fix has subsequently been used.",2]
  113.    SH[30,212,'The "Save" gadget makes it easy to make a new base set if you wish to.',2]
  114.    SH[30,226,"The other two modes open with the colours of the loaded file, but",2]
  115.    SH[30,234,"unless you use the Fix gadget, the Rset gadget will reset them",2]
  116.    SH[30,242,"to those defined in P$.",2]
  117. End Proc
  118. Procedure EX4
  119.    Screen Open 1,640,260,4,Hires : RESET
  120.    Curs Off : Flash Off 
  121.    SH[44,40,"Four demo screens in Lowres (Width = 320).",3]
  122.    SH[60,60,"These will use 4, 8, 16, and 32 colours.",2]
  123.    SH[60,70,"The third of the four is set to display a file selector.",2]
  124.    SH[60,80,"Just click on Quit for now.",2]
  125.    SH[60,110,"For the last example, the file :Amospic.IFF will be",2]
  126.    SH[60,120,"loaded, and the colours of that file will be used.",2]
  127.    SH[60,130,"If you encounter a problem, check its location.",2]
  128.    SH[60,150,"A click on Fix will prevent the colours on the screen from",2]
  129.    SH[60,160,"being Reset to the Palette Setter's own set of colours.",2]
  130.    SH[140,180,"Press any key to continue.",3]
  131.    Wait Key : Screen Close 1
  132. End Proc
  133. Procedure SH[TX,TY,T$,I]
  134.    Colour 3,$FB5
  135.    Gr Writing 0
  136.    Ink 0 : Text TX+1,TY+1,T$
  137.    Ink I : Text TX,TY,T$
  138. End Proc
  139. ' =============  Procedures called by PALET[mode$]  =============
  140. Procedure PALET[F$]
  141.    If F$="1"
  142.       F$=Fsel$("*.IFF","","Load an IFF file") : 
  143.       If F$<>"" : Load Iff F$,1 : End If 
  144.    Else 
  145.       If F$<>"0" : Load Iff F$ : End If 
  146.    End If 
  147.    Shared WX,WY,P$
  148.    SW=Screen Width
  149.    NC=Screen Colour
  150.    P$="$000,$79A,$FFF,$FB5,$FF0,$0F0,$F00,$800,$9DF,$59F,$D00,$ACC,$FC0,$D80,$840,$FCC,$FFF,$DDD,$CCC,$AAA,$999,$777,$666,$444,$FB0,$EA0,$C90,$B80,$A60,$950,$740,$630"
  151.    Reserve Zone NC+10 : Flash Off : Curs Off 
  152.    WX=SW/4-50 : WY=20
  153.    Wind Save 
  154.    If(F$="0") or(F$="") : RESET : End If 
  155.    Repeat 
  156.       PALWIN
  157.    Until Param=0
  158. End Proc
  159. Procedure PALWIN
  160.    Shared WX,WY,CHOYCE
  161.    OPEN_WINDOW[1] : Curs Off 
  162.    PREPARE_SAMPLER
  163.    CHOYCE=1 : H$=Hex$(Colour(1),3) : DISPLAY_H : SLIDER_VALUES : PZ=0
  164.    MAIN
  165.    AGAIN=(Param=10)
  166.    Wind Close 
  167. End Proc[AGAIN]
  168. Procedure MAIN
  169.    Shared WX,WY,X,Z,CHOYCE,P$
  170.    NC=Screen Colour
  171.    Limit Mouse 128,42 To 446,298
  172.    Repeat 
  173.       M=Mouse Key : Z=Mouse Zone
  174.       If Z<4 : SLIDER[Z]
  175.       Else 
  176.          If Z>3 and Z<11 and M
  177.             X=X Mouse : X=X Screen(X)
  178.             On Z-3 Proc DUP_COL,RANGE,QUIT,SAIVE,FIKS,RESET,NEWPOS
  179.          Else 
  180.             If(Z>10) and(Z<(NC+11)) and M : CHOOSE_COLOUR : M=0 : End If 
  181.          End If 
  182.       End If 
  183.    Until M<>0 and(Z=6 or Z=(10))
  184. End Proc[Z]
  185. Procedure FIKS
  186.    Shared P$
  187.    W_SH[114,75,"Fix",2]
  188.    NC=Screen Colour
  189.    P$=""
  190.    For I=0 To NC-1
  191.       P$=P$+Hex$(Colour(I),3)+","
  192.    Next 
  193.    W_SH[114,75,"Fix",3]
  194. End Proc
  195. Procedure RESET
  196.    Shared P$
  197.    NC=Screen Colour
  198.    For I=0 To NC-1
  199.       C$=(Mid$(P$,(I*5)+1,4)) : Colour I,Val(C$)
  200.    Next 
  201. End Proc
  202. Procedure QUIT
  203. End Proc
  204. Procedure SAIVE
  205.    Shared WX,WY,P$
  206.    W_SH[150,64,"Save",2]
  207.    Open Out 1,"RAM:palset.ASC"
  208.    Print #1,""
  209.    Print #1,"     The characters between < and > may be assigned to P$"
  210.    Print #1,"     in the 11th line of Procedure PALET[].  For this, there"
  211.    Print #1,"     must be FOUR characters in each element (e.g. $F00"
  212.    Print #1,"     should not be reduced to $F)."
  213.    Print #1,""
  214.    Print #1,"<"
  215.    Print #1,P$
  216.    Print #1,">"
  217.    Print #1,""
  218.    Print #1,"     The data may, of course, be useful in other applications."
  219.    Close 1
  220.    W_SH[150,64,"Save",3]
  221. End Proc
  222. Procedure DUP_COL
  223.    Shared WX,WY,CHOYCE,X
  224.    D1=Val(Hex$(Colour(CHOYCE),3))
  225.    Gr Writing 0
  226.    If X<WX+146
  227.       MBOSS[110,35,145,44] : W_SH[113,42,"To?",2]
  228.    Else 
  229.       MBOSS[148,35,184,44] : W_SH[151,42,"With",2]
  230.    End If 
  231.    NEWZ=0 : Repeat : M=Mouse Click : NEWZ=Mouse Zone : Until NEWZ>10 and M
  232.    D2=Val(Hex$(Colour(NEWZ-11),3))
  233.    Colour NEWZ-11,D1
  234.    If X<WX+146
  235.       MBOSS[110,35,145,44] : W_SH[113,42,"Copy",3]
  236.    Else 
  237.       Colour CHOYCE,D2
  238.       MBOSS[148,35,184,44] : W_SH[151,42,"Swap",3] : 
  239.    End If 
  240.    Gr Writing 1
  241. End Proc
  242. Procedure RANGE
  243.    Shared WX,WY,CHOYCE
  244.    W_SH[158,53,"To?",2]
  245.    Repeat : M=Mouse Click : NEWZ=Mouse Zone : Until NEWZ>10 and M
  246.    Ink 1 : W_BAR[158,47,182,54] : FIRST=CHOYCE : LAST=NEWZ-11
  247.    C1$=Hex$(Colour(FIRST),3)
  248.    R1=Val(Left$(C1$,2)) : G1=Val("$"+Mid$(C1$,3,1)) : B1=Val("$"+Right$(C1$,1))
  249.    C2$=Hex$(Colour(LAST),3)
  250.    R2=Val(Left$(C2$,2)) : G2=Val("$"+Mid$(C2$,3,1)) : B2=Val("$"+Right$(C2$,1))
  251.    CASES#=Abs(LAST-FIRST) : If LAST=FIRST : Pop Proc : End If 
  252.    RDIR=(R1>R2)+Abs(R1<R2) : GDIR=(G1>G2)+Abs(G1<G2) : BDIR=(B1>B2)+Abs(B1<B2)
  253.    RDIST#=Abs(R1-R2) : R_PIECE#=(RDIST#/CASES#)
  254.    GDIST#=Abs(G1-G2) : G_PIECE#=(GDIST#/CASES#)
  255.    BDIST#=Abs(B1-B2) : B_PIECE#=(BDIST#/CASES#) : T=0
  256.    For K=FIRST+1 To LAST-1
  257.       Inc T
  258.       NEWR#=R1+RDIR*T*R_PIECE# : NEWG#=G1+GDIR*T*G_PIECE# : NEWB#=B1+BDIR*T*B_PIECE#
  259.       THISCOL=Val(Hex$(Int(NEWR#+0.5),1)+Right$(Hex$(Int(NEWG#+0.5),1),1)+Right$(Hex$(Int(NEWB#+0.5),1),1))
  260.       Colour K,THISCOL
  261.    Next 
  262. End Proc
  263. Procedure CHOOSE_COLOUR
  264.    Shared WX,WY,Z,CHOYCE,H$
  265.    CHOYCE=Z-11
  266.    DISPLAY_H
  267.    Colour CHOYCE,Val(H$)
  268.    Ink CHOYCE : W_BAR[7,3,35,20]
  269.    SLIDER_VALUES
  270. End Proc
  271. Procedure DISPLAY_H
  272.    Shared WX,WY,CHOYCE,H$
  273.    H$=Hex$(Colour(CHOYCE),3)
  274.    Gr Writing 1 : Ink 0,1 : Text WX+9,WY+31,Right$(H$,3) : Ink 2,1
  275. End Proc
  276. Procedure PREPARE_SAMPLER
  277.    Shared WX,WY
  278.    MBOSS[6,2,36,21] : MBOSS[6,23,36,33]
  279.    W_ZONE[10,6,2,36,21]
  280.    W_SH[44,9,"R",3] : W_SH[44,19,"G",3]
  281.    W_SH[44,29,"B",3]
  282.    X1=56 : X2=184
  283.    For I=0 To 2
  284.       Y1=2+I*10 : Y2=10+I*10 : MBOSS[X1,Y1,X2,Y2]
  285.       W_ZONE[I+1,X1,Y1,X2,Y2]
  286.       If I<2 : Ink 0 : For J=1 To 15 : W_PLOT[WX,WY,X1+J*8,Y2+1] : Next : End If 
  287.    Next 
  288.    MBOSS[110,35,145,44] : MBOSS[148,35,184,44] : W_ZONE[4,110,35,184,44]
  289.    MBOSS[110,46,184,55] : W_ZONE[5,110,46,184,55]
  290.    MBOSS[110,57,145,66] : W_ZONE[6,110,57,145,66]
  291.    MBOSS[148,57,184,66] : W_ZONE[7,148,57,184,66]
  292.    MBOSS[110,68,145,77] : W_ZONE[8,110,68,145,77]
  293.    MBOSS[148,68,184,77] : W_ZONE[9,148,68,184,77]
  294.    W_SH[113,42,"Copy",3] : W_SH[151,42,"Swap",3] : W_SH[114,53,"Range",3]
  295.    W_SH[114,64,"OK",3] : W_SH[151,64,"Save",3]
  296.    W_SH[114,75,"Fix",3] : W_SH[151,75,"Rset",3]
  297.    '  Sample rows 
  298.    X1=6 : Y1=36 : X2=102 : Y2=76
  299.    NC=Screen Colour
  300.    MBOSS[X1-1,Y1,X2,Y2+1]
  301.    NROWS=2+2*Abs(NC>12) : NCOLS=NC/(2+(2*Abs(NC>8)))
  302.    RSTEP=40/NROWS : CSTEP=96/NCOLS
  303.    R1=Y1 : C1=X1 : C2=X2-CSTEP : I=0
  304.    For R=1 To NROWS
  305.       For C=1 To NCOLS
  306.          Ink I : W_BAR[C1,R1+1,C1+CSTEP-1,R1+RSTEP]
  307.          W_ZONE[I+11,C1+1,R1+1,C1+CSTEP-1,R1+RSTEP]
  308.          Add C1,CSTEP,X1 To C2 : Inc I
  309.       Next 
  310.       Add R1,RSTEP
  311.    Next 
  312. End Proc
  313. Procedure OPEN_WINDOW[N]
  314.    Shared WX,WY
  315.    WX=(WX+8)/16*16
  316.    Wind Open N,WX,WY,24,10 : Curs Off : Flash Off 
  317.    Ink 2 : Set Pattern 31 : W_BAR[1,1,191,79] : Set Pattern 0
  318.    X2=WX+191 : Y2=WY+79
  319.    Ink 2 : Polyline WX,Y2 To X2,Y2 To X2,WY
  320.    Ink 0 : Polyline WX,Y2 To WX,WY To X2,WY
  321. End Proc
  322. Procedure MBOSS[X1,Y1,X2,Y2]
  323.    Shared WX,WY
  324.   ' X1=WX+X1 : Y1=WY+Y1 : X2=WX+X2 : Y2=WY+Y2
  325.    Add X1,WX : Add Y1,WY : Add X2,WX : Add Y2,WY
  326.    Ink 1 : Bar X1,Y1 To X2,Y2
  327.    Ink 0 : Polyline X1,Y2 To X2,Y2 To X2,Y1
  328.    Ink 2 : Polyline X1,Y2 To X1,Y1 To X2,Y1
  329. End Proc
  330. Procedure W_SH[TX,TY,T$,I]
  331.    Shared WX,WY
  332.    Gr Writing 0
  333.    Ink 0 : Text WX+TX+1,WY+TY+1,T$
  334.    Ink I : Text WX+TX,WY+TY,T$
  335.    Gr Writing 1
  336. End Proc
  337. Procedure W_PLOT[WX,WY,X,Y]
  338.    Plot WX+X,WY+Y
  339. End Proc
  340. Procedure W_DRAW[X1,Y1,X2,Y2]
  341.    Shared WX,WY
  342.    Draw WX+X1,WY+Y1 To WX+X2,WY+Y2
  343. End Proc
  344. Procedure W_BAR[X1,Y1,X2,Y2]
  345.    Shared WX,WY
  346.    Bar WX+X1,WY+Y1 To WX+X2,WY+Y2
  347. End Proc
  348. Procedure W_ZONE[N,X1,Y1,X2,Y2]
  349.    Shared WX,WY
  350.    Set Zone N,WX+X1,WY+Y1 To WX+X2,WY+Y2
  351. End Proc
  352. Procedure SLIDER[Z]
  353.    Shared WX,WY,Z,CHOYCE,H$
  354.    PX=0
  355.    While Mouse Key=1
  356.       X=X Screen(X Mouse)
  357.       If Z>0 and X<>PX and X>WX+56
  358.          DISPLAY_H
  359.          RED$="$"+Mid$(H$,2,1) : GREEN$="$"+Mid$(H$,3,1) : BLUE$="$"+Right$(H$,1)
  360.          X1=WX+57 : X2=X : X3=X1+126 : Y1=WY+3+(Z-1)*10 : Y2=Y1+6
  361.          If X1+1<X2 and X2<X3 : 
  362.             Ink 2 : Set Pattern 32 : Bar X1+1,Y1+1 To X2,Y2-1 : Set Pattern 0
  363.             If X2+1<X3 : Ink 1 : Bar X2,Y1 To X3,Y2 : End If 
  364.             'Set colour as bar moves 
  365.             DISTANCE=(X2-X1)/8
  366.             If DISTANCE<10
  367.                DIST$=Str$(DISTANCE)
  368.             Else 
  369.                DIST$=Chr$(55+DISTANCE)
  370.             End If 
  371.             If Z=1 : RED$=DIST$
  372.             Else 
  373.                If Z=2 : GREEN$=DIST$
  374.                Else 
  375.                   If Z=3 : BLUE$=DIST$ : End If 
  376.                End If 
  377.             End If 
  378.             H$="$"+Right$(RED$,1)+Right$(GREEN$,1)+Right$(BLUE$,1)
  379.             Colour CHOYCE,Val("$"+Right$(RED$,1)+Right$(GREEN$,1)+Right$(BLUE$,1))
  380.             Ink CHOYCE : Bar WX+7,WY+3 To WX+35,WY+17 : DISPLAY_H
  381.          End If 
  382.       End If 
  383.       PX=X
  384.    Wend 
  385. End Proc
  386. Procedure SLIDER_VALUES
  387.    Shared WX,WY,H$
  388.    RED$="$"+Mid$(H$,2,1) : GREEN$="$"+Mid$(H$,3,1) : BLUE$="$"+Right$(H$,1)
  389.    X1=WX+57 : X3=X1+126
  390.    For Z=1 To 3
  391.       If Z=1 : X2=Val(RED$)
  392.       Else 
  393.          If Z=2 : X2=Val(GREEN$)
  394.          Else 
  395.             X2=Val(BLUE$)
  396.          End If 
  397.       End If 
  398.       X2=WX+56+X2*8+8 : Y1=WY+3+(Z-1)*10 : Y2=Y1+6
  399.       Ink 2 : Set Pattern 32 : Bar X1+1,Y1+1 To X2-1,Y2-1 : Set Pattern 0
  400.       If X2+1<X3 : Ink 1 : Bar X2,Y1 To X3,Y2 : End If 
  401.    Next 
  402. End Proc
  403. Procedure NEWPOS
  404.    Shared WX,WY
  405.    SW=Screen Width
  406.    M=0 : Ink 3 : Gr Writing 2
  407.    While M=0
  408.       X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  409.       If X<>OX and Y<>OY : Box X,Y To X+192,Y+80 : Box X,Y To X+192,Y+80 : End If 
  410.       M=Mouse Click : OX=X : OY=Y
  411.    Wend 
  412.    Ink 1 : Gr Writing 1
  413.    WX=X Screen(X Mouse) : If WX>SW-192 : WX=SW-192 : End If 
  414.    WY=Y Screen(Y Mouse) : If WY>180 : WY=176 : End If 
  415.    WX=(WX+8)/16*16
  416. End Proc